Loadstar 162/162.d81/psf.charter 2

Commodore BASIC | 1997-01-01 | 6.4 KB | 305 lines

10 sys700
20 .opt oo
30 *=$7000
40 poi = $fb
50 chrout = $ffd2
99 ;-----------------------------------
100 jsr param ;1=commie 2,3,4,5=epson
110 tya
120 beq hop120 ;error
130 cmp #6
140 bcs hop120 ;error
150 cmp #1
160 beq hop160
170 sta epson25 ;save for sendctrl type
180 jmp doepson
190 hop160 jmp docommie
195 hop120 rts ;exit if # out of range
200 ;----------------------------------
210 param = * ;get parameter from basic
220 jsr $aefd
230 jsr $ad9e
240 jmp $b7f7 ;a=hb y=lb
300 ;----------------------------------
310 grab = * ;get byte at x0-39 y0-199
320 stx tempxdg
330 sty tempydg ;save these
340 lda #0
350 sta poi+1 ;hb=0
360 tya
370 and #%11111000 ;8*int(y/8)
380 asl:rol poi+1 ;*16
390 asl:rol poi+1 ;*32
400 asl:rol poi+1 ;*64
410 sta poi
420 sta templ64 ;(needed for *320 calc)
430 lda poi+1
440 sta temph64
450 asl poi:rol poi+1 ;*128
460 asl poi:rol poi+1 ;*256
470 clc
480 lda poi
490 adc templ64
500 sta poi ;add *256 & *64 to get *320
510 lda poi+1
520 adc temph64
530 sta poi+1
540 txa
550 asl:asl:asl ;8*cellx
560 php ;save if cellx>=32 status
570 clc
580 adc poi
590 sta poi ;add it
600 lda poi+1
605 adc #>8192 ;add bitmap's hb!
610 sta poi+1
620 plp
630 bcc hop630
640 inc poi+1 ;inc hb if cellx>=32
650 hop630 tya
660 and #7 ;add y and 7
670 clc
680 adc poi
690 sta poi
700 bcc hop700
705 inc poi+1
710 hop700 ldy #0
720 lda (poi),y ;*** get byte !!! ***
730 ldx tempxdg
740 ldy tempydg ;restore these
750 rts
800 ;----------------------------------
810 dorow1 = * ;do left 4 bits of col
820 ldy #199
830 lup920 jsr grab ;get byte
840 lsr:lsr:lsr:lsr
850 tay
860 lda fatline,y ;get byte for printer
870 jsr chrout ;and send it twice
875 jsr chrout
880 ldx tempxdg
890 ldy tempydg
900 dey
910 cpy #255 ;done column"?
920 bne lup920
930 rts
1000 ;[171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171]
1010 d[176]ow2 [178] [172] ;do right 4 bits of col
1020 ldy #199
1030 lup1120 jsr grab ;[161] byte
1040 [175] #15
1050 tay
1060 lda fatline,y ;[161] [153]er byte
1070 jsr chrout ;[175] s[128] it twice
1075 jsr chrout
1080 ldx tempxdg
1090 ldy tempydg
1100 dey
1110 cpy #255 ;d[145]e column"?
1120 bne lup1120
1130 rts
1200 ;---------------------------------
1210 sendctrl = * ;send control codes
1212 txa:pha
1220 ldx epson25 ;which driver 2-5"?
1230 ldy drivers[171]2,x ;(offsets)
1240 lup1280 lda allcodes,y
1250 beq hop1250
1260 jsr chrout ;s[128] [154]rol codes...
1270 iny
1280 jmp lup1280
1290 hop1250 pla:tax
1295 rts
1500 ;[171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171]
1510 doeps[145] [178] [172] ;[153] bitmap [145] eps[145]
1520 ldx #0
1530 lup1630 jsr s[128]ctrl ;graphics [145]
1540 jsr d[176]ow1 ;left 1[173]2 of column
1550 lda #13
1560 jsr chrout
1570 jsr s[128]ctrl ;graphics [145]
1580 jsr d[176]ow2 ;right 1[173]2 of column
1590 lda #13
1600 jsr chrout
1610 inx
1620 cpx #40 ;d[145]e entire screen"?
1630 bne lup1630
1640 rts
2000 ;---------------------------------
2010 docommie = * ;print bitmap on c=
2020 lda #0
2030 sta cur7pinx ;horiz b'map counter
2040 sta cur7pinx+1
2050 sta flip7pin ;if bit7 then pin 7 is single (else 1 is)
2100 lup2260 jsr column7 ;*** send column ***
2110 lda flip7pinx
2120 asl
2130 lda #3 ;add 3 or 4 to curpinx
2140 adc cur7pinx
2150 sta cur7pinx
2160 bcc hop2160
2170 inc cur7pinx+1
2180 hop2160 lda flip7pin
2190 eor #128 ;toggle pattern (1122334 to 1223344)
2200 sta flip7pin
2210 sec
2220 lda cur7pinx ;check if bitmap done
2230 sbc #<320
2240 lda cur7pinx+1
2250 sbc #>320
2260 bcc lup2260
2270 rts
2400 ;---------------------------------
2410 bytefor7 = * ;get byte from bitmap
2420 lda #7
2430 sta bitstodo ;7 bits for 7 pins
2440 lda cur7pinx
2450 sta peekx
2460 lda cur7pinx+1 ;for chekpeek
2470 sta peekx+1
2480 lda #0
2490 sta rorthis ;work byte
2500 lup2540 jsr chekpeek ;check bit
2510 ror rorthis
2520 jsr advance
2530 dec bitstodo ;done all"?
2540 bne lup2540
2550 sec
2560 r[176] r[176]this ;set bit 7 (c[178] [153]ers need this!)
2570 rts
2600 ;[171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171]
2610 advance [178] [172] ;inc [194]x properly
2620 bit flip7pin
2630 bmi hop2630 ;pattern [129] bit pairs
2640 lda bits[164]do
2650 lsr
2660 bcc hop2660
2670 rts
2700 hop2630 lda bits[164]do
2710 lsr
2720 bcs hop2660
2730 rts
2800 hop2660 inc [194]x
2810 bne hop2810
2820 inc [194]x[170]1
2830 hop2810 rts
2900 ;[171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171]
2910 s[128]ctr7 [178] [172] ;s[128] ctrlcodes [129] 7
2920 ldx #0
2930 lup2970 lda ctrl[129]7,x
2940 beq hop2940
2950 jsr chrout
2960 inx
2970 jmp lup2970
2980 hop2940 rts
3000 ;[171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171][171]
3010 column7 [178] [172] ;s[128] column [129] 7[171]pin
3020 jsr s[128]ctr7 ;graphic [145]
3030 lda #199
3040 sta [194]y
3050 lup3120 jsr byte[129]7 ;[161] byte
3060 lda r[176]this
3070 jsr chrout ;s[128] it twice
3080 jsr chrout
3090 dec [194]y
3100 lda [194]y
3110 cmp #255 ;d[145]e column"?
3120 bne lup3120
3130 lda #13 ;send carriage return
3140 jmp chrout ;(& rts)
3200 ;---------------------------------
3210 chekpeek = * ;sends bit-state @peekx/y back in carry
3220 lda #0
3230 sta poi+1 ;hb;0
3240 lda peeky
3250 lsr:lsr:lsr ;int (y/8)
3260 sta poi ;(save *1)
3270 asl:asl ;*4
3280 clc
3290 adc poi
3300 sta poi ;*5
3310 ldy #6
3320 lup3350 asl poi ;*10,*20,*40,*80,*160,*320
3330 rol poi+1
3340 dey
3350 bne lup3350
3360 clc
3370 lda peekx
3380 and #%11111000 ;8*int(x/8)
3390 adc poi
3400 sta poi
3410 lda poi+1
3420 adc peekx+1 ;hb ok as is
3430 sta poi+1
3440 clc
3450 lda peeky
3460 and #7
3470 adc poi ;(y and 7 for within cell)
3480 sta poi
3490 lda poi+1
3500 adc #>8192 ;add bitmap's hb
3510 sta poi+1
3520 lda peekx
3530 and #7 ;ready bit mask
3540 tax
3550 ldy #0
3560 lda (poi),y
3570 and bitmasks,x
3580 php ;*** save possible result ***
3590 sec
3600 lda peekx
3610 sbc #<320
3620 lda peekx+1
3630 sbc #>320
3640 bcc hop3640 ;ok - is in range
3650 plp
3660 clc ;out or range = always clear!
3670 rts
3700 hop3640 plp
3710 beq hop3710
3720 sec ;in range and set
3730 rts
3750 hop3710 clc ;in range and clear
3760 rts
5000 ;---------------------------------
5010 tempxdg .byte 0
5020 tempydg .byte 0
5030 templ64 .byte 0
5040 temph64 .byte 0
5050 epson25 .byte 0
5100 fatline = * ;double width nybbles!
5110 .byte %00000000
5120 .byte %00000011
5130 .byte %00001100
5140 .byte %00001111
5150 .byte %00110000
5160 .byte %00110011
5170 .byte %00111100
5180 .byte %00111111
5210 .byte %11000000
5220 .byte %11000011
5230 .byte %11001100
5240 .byte %11001111
5250 .byte %11110000
5260 .byte %11110011
5270 .byte %11111100
5280 .byte %11111111
5300 allcodes = * ;4 printer drivers
5310 d2 .byte 32,32,32,32,32,32,27,49,27,75,<400,>400,0
5320 d3 .byte 32,32,32,32,32,32,27,49,27,203,<400,>400,0
5330 d4 .byte 32,32,32,32,32,32,27,65,8,27,75,<400,>400,0
5340 d5 .byte 32,32,32,32,32,32,27,193,8,27,203,<400,>400,0
5350 drivers .byte d2-allcodes,d3-allcodes,d4-allcodes,d5-allcodes ;offsets
6000 ;---------------------------------
6010 peekx .byte 0,0
6020 peeky .byte 0
6030 cur7pinx .byte 0,0
6040 flip7pin .byte 0
6050 rorthis .byte 0
6060 bitstodo .byte 0
6200 bitmasks .byte 128,64,32,16,8,4,2,1 ;for chekpeek
6210 ctrlfor7 .byte 15,32,32,32,32,32,32,8,0 ;for 7-pin
63000 ;--------------------------------
63998 .end:end
63999 a$="psf.charter 2":open15,8,15,"s0:"+a$:close15:savea$,8